home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / PASCAL / ALLSWAGS.ZIP / SWAGG-M.ZIP / MISC.SWG / 0141_General Useful Routines.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-26  |  1.6 KB  |  83 lines
  1. Unit Goodies; {Collection of things I wish were in the System Unit}
  2.  
  3. Interface
  4. Type Fixed= Record F:Word;W:Integer;end;
  5.  
  6. Var r,r2,r3:Word;
  7.  
  8. Function Greater(a,b:Integer):Integer;
  9. Function Lesser(a,b:Integer):Integer;
  10. Function Perturb:Word;  {Peturbation algorhythm (C) 1982 BarathSoft}
  11. Function QRandWord:word;
  12. Function QRand(n:Word):word;
  13. Function SQRoot(N:LongInt):Word;
  14. Function SGN(n:Integer):Integer;
  15.  
  16. Implementation
  17.  
  18. Function Greater(a,b:Integer):Integer;assembler;
  19. asm
  20.   Mov  ax,a
  21.   Mov  bx,b
  22.   Cmp  ax,bx
  23.   Jnc  @done
  24.   Xchg ax,bx
  25. @Done:
  26. end;
  27. Function Lesser(a,b:Integer):Integer;assembler;
  28. asm
  29.   Mov  ax,a
  30.   Mov  bx,b
  31.   Cmp  ax,bx
  32.   Jc   @done
  33.   Xchg ax,bx
  34. @Done:
  35. end;
  36.  
  37. Function Perturb:Word;assembler;  {Peturbation algorhythm (C) 1982 
  38. BarathSoft}
  39. {Delta 2904 yields 65534 length pseudorandom sequence}
  40. asm Mov ax,r; Xor ax,$a5a5; add ax,ax; adc ax,2904; Mov r,ax; end;
  41. Function QRandWord:word;assembler;
  42. asm Call Perturb; Add ax,r2;Mov r2,ax;Xor ax,r3;Mov r3,ax;end;
  43. Function QRand(n:Word):word;assembler;
  44. asm Call QRandWord; Mul n; Mov ax,dx; end;
  45. Function SQRoot(N:LongInt):Word;Assembler;
  46. asm
  47.   Mov si,-1
  48.   Mov cx,n+2.word
  49.   Test ch,$80
  50.   JNZ @Error
  51.   Mov bx,n.word
  52.   Mov di,32768
  53.   Xor si,si
  54. @DoSqrt:
  55.   Mov ax,si
  56.   Or  ax,di
  57.   Mul ax
  58.   Cmp dx,cx
  59.   Ja  @NoSet
  60.   Jnz @Set
  61.   Cmp ax,bx
  62.   Ja  @Noset
  63. @Set:
  64.   Or  si,di
  65. @Noset:
  66.   Shr di,1
  67.   Jnz @DoSqrt
  68. @Error:
  69.   Mov ax,si
  70. end;
  71. Function SGN(n:Integer):Integer;assembler;
  72. asm
  73.   Xor ax,ax
  74.   Cmp n,ax
  75.   Js  @neg
  76.   Inc ax
  77.   Jmp @end
  78. @neg:
  79.   Dec ax
  80. @end:
  81. end;
  82. end.
  83.